package Object;

use strict;
use warnings;

use Object::Info;
use Object::_;

use Carp ();
our @CARP_NOT = qw(Object::Info Object Object::_);
use Sub::Name;
use Data::Dumper;

our @ADD_FIELDS = ();
our %STAGE;


=begin

use Object {
	extends|base   => ''|[],
	
	public         => [],
	private        => [],
	protected      => [],
	
	options   => {
		accs|accessors => public | private | protected | all | 1
		check => fields | accessors | all | 1
		fast  => 0 | 1
	}
}, extends|base => ''|[], implements => ''|[],

=cut

sub import {
	my $pkg = shift;
	return unless @_;
	my $at = Object::_::at();
	my $cls = caller(0);
	#$cls = __PACKAGE__ if $cls eq 'main';
	my $ref;
	my $bases = [ 'Object' ];
	my %bases = ();
	my %fields;
	my $opts;
	my $load_modules = subname '~load_modules' => sub {
		no strict 'refs';
		for my $base (@_) {
			my $ver = ${$base.'::'}{VERSION};
			if ( ($ver && *$ver{SCALAR}) ) {
				${$base.'::VERSION'} = '-1, set by Object.pm like base'
					unless defined ${$base.'::VERSION'};
			}
			else {
				local $SIG{__DIE__};
				eval "require $base";
				# Only ignore "Can't locate" errors from our eval require.
				# Other fatal errors (syntax etc) must be reported.
				die if $@ && $@ !~ /^Can't locate .*? at \(eval /; # '
				unless (%{"$base\::"}) {
					Carp::croak(qq{Base class package "$base" is empty.\n\t}.
						q{(Perhaps you need to 'use' the module which defines that package first.)});
				}
				${$base.'::VERSION'} = '-1, set by Object.pm like base'
					unless defined ${$base.'::VERSION'};
			}
			#warn "$base load OK\n";
		}
	};
	my $set_base = subname '~set_base' => sub {
		#warn "$cls: set base @_\n";
		for my $base (@{ ref $_[0] eq 'ARRAY' ? $_[0] : \@_ }) {
			$load_modules->($base);
			$bases{$base} and Carp::carp( "$cls already inherited from $base" ),next;
			#shift @$bases if $bases->[0] eq 'Object' and $base->isa('Object');
			push @$bases,$base;
		}
	};
	my %postfix = (
		base       => $set_base,
		implements => subname 'postfix:implements' => sub {
			my @list = @{ ref $_[0] eq 'ARRAY' ? $_[0] : \@_ };
			for my $base (@list) {
				$load_modules->($base);
				$bases{$base} and Carp::carp( "$cls already inherited from $base" ),next;
				#shift @$bases if $bases->[0] eq 'Object' and $base->isa('Object');
				unshift @$bases,$base;
			}
			#$set_base->(@list);
			Object::_::check_implements($cls,$at,@list);
		},
	);
	$postfix{extends} = $postfix{base};
	$postfix{extend} = sub { Carp::carp "possible typo: `extend' instead of `extends'"; };
	
	if ($ref = ref $_[0]) {
		while (@_ > 2 and exists $postfix{$_[-2]}){
			my ($key,$val) = splice(@_,-2,2);
			#warn "$cls: splice $key with (@$val). rest = @_\n";
			$postfix{$key}->($val);
		}
		if ($ref eq 'ARRAY') {
			$fields{public} = shift;
			if (@_) {
				if (@_ == 1) {
					$_ = shift;
					if ($ref = ref) {
						if ($ref eq 'HASH') {
							$opts = $_;
						}
						elsif ($ref eq 'ARRAY'){
							$opts = {};
							@$opts{@$_} = (1)x@$_;
						}
						else {
							Carp::croak "Wrong syntax. Don't expect $ref as second argument";
						}
					}
					else {
						my @vals = split /\s*[;,]\s*/,$_;
						@$opts{@vals} = (1)x@vals;
					}
				}else{
					Carp::croak "Wrong syntax. Don't expect more then 2 ref arguments, but get: $fields{public} @_";
				}
			}else{
				$opts = {};
			}
		}
		elsif($ref eq 'HASH') {
			my $o = shift;
			for (keys %postfix) {
				if (exists $o->{$_}) {
					$postfix{$_}->( delete $o->{$_} );
				}
			}
			$fields{public}    = delete $o->{public}    || delete $o->{pub} || [];
			$fields{private}   = delete $o->{private}   || delete $o->{pri} || [];
			$fields{protected} = delete $o->{protected} || delete $o->{pro} || [];
			
			$opts = eval{ Object::_::option( delete $o->{options} || delete $o->{opts} || {} ) };
			Carp::croak("$$@ as options") if ref $@;
			my $b = delete $o->{base};
			if ($ref = ref $b) {
				if ($ref eq 'ARRAY') {
					$set_base->(@$b);
				}else{
					Carp::croak "Wrong syntax. Don't expect $ref as base";
				}
			}else{
				$set_base->($b) if defined $b;
			}
			my @left = keys %$o;
			Carp::croak "Unknown keys in initialization hash: @left" if @left;
		}
		else{
			Carp::croak "Wrong syntax. ".ref($_[0])." is not allowed as first argument";
		}
	}else{
		if (grep ref $_,@_) {
			Carp::croak "Can't use plain syntax with references: @_";
		}else{
			if ($postfix{$_[-2]}) {
				Carp::carp
					"You pass @_[-2,-1] as 2 last arguments.\n".
					"In plain syntax it wouldn't be inheritance but 2 public fields\n".
					"Possible you write use Object qw(...), @_[-2,-1].".
					"To work it may be written as use Object [qw(...)], @_[-2,-1].";
			}
			$fields{public} = [ @_ ];
			$opts = {};
		}
	}
	{
		#warn "$cls: bases = @$bases\n";
		no strict 'refs';
		my $isa_obj = 0;
		for my $base ( reverse @$bases ) {
			#warn "pushing $base (isa=".$base->isa('Object').")\n";
			next if $cls->isa($base);
			$isa_obj ||= ( $base ne 'Object' && $base->isa('Object') );
			push @{ $cls.'::ISA' }, $base if ($base ne 'Object' or ( $base eq 'Object' and !$isa_obj ));
		}
		#warn "$cls: ISA = @{ $cls.'::ISA' }\n";
	}
	my $info = eval { Object::Info->new( $cls,\%fields,$opts ) };
	die $@ if $@;
	Object::_::make_accessors($cls,$at);
	if ($STAGE{CHECK}) {
		# CHECK stage was already passed. The most possible we're was loaded by eval '...';
		# So make accessors and check implementation right now
		Object::_::check_implements_do($cls);
		Object::_::make_accessors_do($cls);
	}
	return;
}

sub fields {
	my $pkg = shift;
	my $type = shift || 'fields';
	Object::Info->get($pkg)->$type;
}

sub new {
	my $pkg = shift;
	$pkg = ref $pkg if ref $pkg;
	my $self;
	my $type = Object::Info->get($pkg)->implementation;
	if (my $call = Object::_->can("new_".$type)) {
		$self = $call->($pkg);
	}
	else{
		Carp::croak "$pkg: Unknown type of object implementation: `$type'";
	}
	$self->init(@_);
	return $self;
}


sub init {
	my $self = shift;
	#warn "Object::init($self)\n";
	my $init = Object::Info->get($self)->initialization;
	my $args;
	if (@_) {
		if (ref $_[0] eq 'HASH') {
			$args = $_[0];
		}elsif( @_ % 2 == 0 ) {
			$args = { @_ };
		}else{
			Carp::carp ref($self).": Bad arguments to new";
		}
	}
	if (my $call = Object::_->can("init_".$init)) {
		$call->(ref $self,$self,$args);
	}
	else{
		Carp::croak ref($self).": Unknown type of object initialization: ".Dumper($init);
	}
	return;
}

sub lvalue:lvalue {
	shift;
	require Object::LvalueCallback unless $INC{'Object/LvalueCallback.pm'};
	my %args = @_;
	tie my $lvalue,'Object::LvalueCallback',$args{get},$args{set};
	$lvalue;
}

BEGIN {
	$STAGE{BEGIN} = 1;
}
INIT {
	$STAGE{INIT} = 1;
}
CHECK {
	$STAGE{CHECK} = 1;
}

1;
